home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt32s1.arc / PIBANSIA.PAS < prev    next >
Pascal/Delphi Source File  |  1985-11-15  |  24KB  |  518 lines
  1. (*----------------------------------------------------------------------*)
  2. (*                Emulate_ANSI  -- Controls VT100 emulation             *)
  3. (*----------------------------------------------------------------------*)
  4.   
  5. OVERLAY PROCEDURE Emulate_ANSI( VT100_Allowed : BOOLEAN );
  6.   
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*    Procedure: Emulate_ANSI                                           *) 
  10. (*                                                                      *)
  11. (*    Purpose:   Controls ANSI terminal emulation                       *)
  12. (*                                                                      *)
  13. (*    Calling Sequence:                                                 *)
  14. (*                                                                      *)
  15. (*       Emulate_ANSI( VT100_allowed );                                 *)
  16. (*                                                                      *)
  17. (*          VT100_allowed --- TRUE to interpret private DEC sequences   *)
  18. (*                                                                      *)
  19. (*    Remarks:                                                          *)
  20. (*                                                                      *)
  21. (*       The ANSI and VT100 emulation are partly based upon TMODEM      *)
  22. (*       by Paul Meiners and partly upon ISP100 by Tim Krauskopf.       *)
  23. (*                                                                      *)
  24. (*       VT100/ANSI commands are interpreted directly by these          *)
  25. (*       routines -- the ANSI.SYS driver is not required and should     *)
  26. (*       probably not be used, as it will result in an unnecessary      *)
  27. (*       performance degradation.                                       *)
  28. (*                                                                      *)
  29. (*       This is by no means a complete VT100 or Ansi emulation.  It    *)
  30. (*       works well enough so that the full-screen editors EDT under    *)
  31. (*       VAX/VMS and FSE under CDC/NOS will perform properly.  That was *)
  32. (*       my primary intention.  You may want to add code to emulate     *) 
  33. (*       other VT100/VT102/VT103/VT131 features not found here.  If you *)
  34. (*       do, please send me back a copy so that I can add your upgrades *)
  35. (*       to future releases of PibTerm.                                 *)
  36. (*                                                                      *)
  37. (*       Also note that this emulation assumes 25 lines on the screen.  *)
  38. (*       The VT100 only has 24.                                         *)
  39. (*                                                                      *)
  40. (*       The following variables are of central interest in the         *) 
  41. (*       emulation:                                                     *)
  42. (*                                                                      *)
  43. (*         Escape_Mode     --- TRUE if processing escape sequence       *)
  44. (*         Escape_Type     --- Type of escape sequence being processed  *)
  45. (*         Escape_Number   --- Number of numeric parameters in escape   *)
  46. (*                             sequence                                 *)
  47. (*         Escape_Register --- array of numeric parameters in escape    *)
  48. (*                             sequence                                 *)
  49. (*         Escape_Str      --- stores string of escape text; used to    *)
  50. (*                             gather up a musical score for BBS Ansi.  *)
  51. (*                                                                      *)
  52. (*----------------------------------------------------------------------*)
  53.   
  54. CONST
  55.    ON   = TRUE                       (* Convenient synonym for switches *);
  56.    OFF  = FALSE                      (* Likewise                        *);
  57.   
  58. VAR
  59.    Comm_Ch             : CHAR        (* Character read from comm port   *);
  60.    Kbd_Ch              : CHAR        (* Character read from keyboard    *);
  61.    VT100_Graphics_Mode : BOOLEAN     (* TRUE if VT100 graphics mode on  *);
  62.    VT100_KeyPad        : BOOLEAN     (* TRUE if alternate keypad in use *);
  63.    Origin_Mode         : BOOLEAN     (* TRUE for region origin mode     *);
  64.    Done                : BOOLEAN     (* TRUE to stop PIBTERM            *);
  65.    B                   : BOOLEAN     (* General purpose flag            *);
  66.    Graph_Ch            : BYTE        (* Graphics character              *);
  67.    Itab                : BYTE        (* Tab stop                        *);
  68.    Tabcol              : BYTE        (* Tab column                      *); 
  69.    Curcol              : BYTE        (* Current column in display       *);
  70.    Auto_Print_Mode     : BOOLEAN     (* IF auto print mode in effect    *);
  71.    Printer_Ctrl_Mode   : BOOLEAN     (* IF printer controller mode on   *);
  72.    Print_Line          : STRING[80]  (* Line to print if print mode on  *);
  73.    Reg_Val             : INTEGER     (* General utility register value  *);
  74.   
  75.    Escape_Mode         : BOOLEAN     (* If processing escape sequence   *); 
  76.    Escape_Number       : INTEGER     (* # of numeric parms in esc seq.  *);
  77.   
  78.                                      (* Holds numeric parms in esc seq  *)
  79.    Escape_Register     : ARRAY[1..50] OF BYTE; 
  80.    Escape_Str          : AnyStr      (* Collects string arg in esc seq  *);
  81.    Escape_Type         : CHAR        (* Type of escape seq. being done  *);
  82.   
  83.                                      (* Remember cursor/attributes      *)
  84.    Save_Row_Position   : INTEGER;
  85.    Save_Col_Position   : INTEGER;
  86.    Save_BG_Color       : INTEGER;
  87.    Save_FG_Color       : INTEGER;
  88.    Save_Graphics_Mode  : BOOLEAN;
  89.                                      (* Save current scrolling region   *) 
  90.    Top_Scroll          : INTEGER;
  91.    Bottom_Scroll       : INTEGER;
  92.   
  93.    Ansi_ForeGround_Color : INTEGER   (* Global foreground color here    *);
  94.    Ansi_BackGround_Color : INTEGER   (* Global background color here    *);
  95.    Ansi_Underline_Color  : INTEGER   (* Color for underlines            *);
  96.    Ansi_Bold_Color       : INTEGER   (* Color for bolding               *);
  97.  
  98.    FG                    : INTEGER   (* Foreground color                *);
  99.    BG                    : INTEGER   (* Background color                *);
  100.  
  101.    Save_Global_FG        : INTEGER   (* Save global foreground color    *);
  102.    Save_Global_BG        : INTEGER   (* Save global background color    *);
  103.    Save_FG               : INTEGER   (* Save foreground color           *);
  104.    Save_BG               : INTEGER   (* Save background color           *);
  105.  
  106.    Double_Width_Mode     : BOOLEAN   (* Double width characters         *);
  107.    Bolding_On            : BOOLEAN   (* TRUE if bolding on              *);
  108.    Blinking_On           : BOOLEAN   (* TRUE if blinking on             *);
  109.  
  110. CONST                                (* Special VT100 graphics chars    *)
  111.   
  112.    Graphics_Chars: ARRAY[ 95 .. 126 ] Of BYTE
  113.                    = (  32,   4, 177,   9,  12,  13,  10, 248, 241,
  114.                         10,  10, 217, 191, 218, 192, 197, 196, 196,
  115.                        196, 196,  95, 195, 180, 193, 194, 179, 243,
  116.                        242, 227, 168, 156, 250 );
  117.  
  118.                                      (* VT100 tabs stops                *)
  119.    Number_VT100_Tabs = 16;
  120.  
  121.    VT100_Tabs:  ARRAY[ 1 .. Number_VT100_Tabs ] OF BYTE
  122.                 = (  9, 17, 25, 33, 41, 49, 57, 65, 73, 74, 75, 76, 77,
  123.                     78, 79, 80 );
  124.  
  125.    Bold_Colors:   ARRAY[Black..White] OF BYTE
  126.                   = ( DarkGray, LightBlue,    LightGreen, LightCyan,
  127.                       LightRed, LightMagenta, Yellow,     White,
  128.                       DarkGray, LightBlue,    LightGreen, LightCyan,
  129.                       LightRed, LightMagenta, Yellow,     White );
  130.  
  131.    Normal_Colors: ARRAY[Black..White] OF BYTE
  132.                   = ( Black, Blue,    Green, Cyan,
  133.                       Red,   Magenta, Brown, LightGray,
  134.                       Black, Blue,    Green, Cyan,
  135.                       Red,   Magenta, Brown, LightGray );
  136.  
  137. (* ------------------------------------------------------------------------ *)
  138. (*               PibPlaySet --- Set up to play music                        *)
  139. (*               PibPlay    --- Play Music through Speaker                  *)
  140. (* ------------------------------------------------------------------------ *)
  141.   
  142. PROCEDURE PibPlaySet;
  143.   
  144. (* ------------------------------------------------------------------------ *)
  145. (*                                                                          *)
  146. (*   Procedure:  PibPlaySet                                                 *)
  147. (*                                                                          *)
  148. (*   Purpose:    Sets up to play music though PC's speaker                  *)
  149. (*                                                                          *)
  150. (*   Calling Sequence:                                                      *)
  151. (*                                                                          *)
  152. (*      PibPlaySet;                                                         *)
  153. (*                                                                          *)
  154. (*   Calls:  None                                                           *)
  155. (*                                                                          *)
  156. (* ------------------------------------------------------------------------ *)
  157.   
  158. BEGIN (* PibPlaySet *) 
  159.   
  160.                                    (* Default Octave *)
  161.    Note_Octave   := 4;
  162.                                    (* Default sustain is semi-legato *)
  163.    Note_Fraction := 0.875;
  164.                                    (* Note is quarter note by default *)
  165.    Note_Length   := 0.25;
  166.                                    (* Moderato pace by default *)
  167.    Note_Quarter  := 500.0;
  168.   
  169. END   (* PibPlaySet *);
  170.   
  171. PROCEDURE PibPlay( S : AnyStr );
  172.   
  173. (* ------------------------------------------------------------------------ *)
  174. (*                                                                          *)
  175. (*   Procedure:  PibPlay                                                    *)
  176. (*                                                                          *)
  177. (*   Purpose:    Play music though PC's speaker                             *)
  178. (*                                                                          *)
  179. (*   Calling Sequence:                                                      *)
  180. (*                                                                          *)
  181. (*      PibPlay( Music_String : AnyStr );                                   *)
  182. (*                                                                          *)
  183. (*         Music_String --- The string containing the encoded music to be   *)
  184. (*                          played.  The format is the same as that of the  *)
  185. (*                          MicroSoft Basic PLAY Statement.  The string     *)
  186. (*                          must be <= 254 characters in length.            *)
  187. (*                                                                          *)
  188. (*   Calls:  Sound                                                          *)
  189. (*           GetInt  (Internal)                                             *) 
  190. (*                                                                          *)
  191. (*   Remarks:  The characters accepted by this routine are:                 *)
  192. (*                                                                          *)
  193. (*             A - G       Musical Notes                                    *)
  194. (*             # or +      Following A - G note,  indicates sharp           *)
  195. (*             -           Following A - G note,  indicates flat            *)
  196. (*             <           Move down one octave                             *)
  197. (*             >           Move up one octave                               *)
  198. (*             .           Dot previous note (extend note duration by 3/2)  *)
  199. (*             MN          Normal duration (7/8 of interval between notes)  *)
  200. (*             MS          Staccato duration                                *)
  201. (*             ML          Legato duration                                  *)
  202. (*             Ln          Length of note (n=1-64; 1=whole note,            *)
  203. (*                                         4=quarter note, etc.)            *)
  204. (*             Pn          Pause length (same n values as Ln above)         *)
  205. (*             Tn          Tempo, n=notes/minute (n=32-255, default n=120)  *)
  206. (*             On          Octave number (n=0-6, default n=4)               *) 
  207. (*             Nn          Play note number n (n=0-84)                      *)
  208. (*                                                                          *)
  209. (*             The following two commands are IGNORED by PibPlay:           *)
  210. (*                                                                          *)
  211. (*             MF          Complete note before continuing                  *)
  212. (*             MB          Another process may begin before speaker is      *)
  213. (*                         finished playing note                            *)
  214. (*                                                                          *)
  215. (*   IMPORTANT --- PibPlaySet MUST have been called at least once before    *)
  216. (*                 this routine is called.                                  *)
  217. (*                                                                          *)
  218. (* ------------------------------------------------------------------------ *)
  219.   
  220. CONST
  221.                                    (* Offsets in octave of natural notes *)
  222.   
  223.    Note_Offset   : ARRAY[ 'A'..'G' ] OF INTEGER
  224.                    = ( 9, 11, 0, 2, 4, 5, 7 );
  225.   
  226.                                    (* Frequencies for 7 octaves *)
  227.   
  228.    Note_Freqs: ARRAY[ 0 .. 84 ] OF INTEGER
  229.                =
  230. (*
  231.       C    C#     D    D#     E     F    F#     G    G#     A    A#     B
  232. *)
  233. (     0,
  234.      65,   69,   73,   78,   82,   87,   92,   98,  104,  110,  116,  123,
  235.     131,  139,  147,  156,  165,  175,  185,  196,  208,  220,  233,  247,
  236.     262,  278,  294,  312,  330,  350,  370,  392,  416,  440,  466,  494,
  237.     524,  556,  588,  624,  660,  700,  740,  784,  832,  880,  932,  988,
  238.    1048, 1112, 1176, 1248, 1320, 1400, 1480, 1568, 1664, 1760, 1864, 1976,
  239.    2096, 2224, 2352, 2496, 2640, 2800, 2960, 3136, 3328, 3520, 3728, 3952,
  240.    4192, 4448, 4704, 4992, 5280, 5600, 5920, 6272, 6656, 7040, 7456, 7904  );
  241.   
  242.    Quarter_Note = 0.25;            (* Length of a quarter note *)
  243.   
  244.   
  245. VAR
  246.                                    (* Frequency of note to be played *)
  247.    Play_Freq     : INTEGER;
  248.   
  249.                                    (* Duration to sound note *)
  250.    Play_Duration : INTEGER;
  251.   
  252.                                    (* Duration of rest after a note *)
  253.    Rest_Duration : INTEGER;
  254.   
  255.                                    (* Offset in Music string *)
  256.    I             : INTEGER;
  257.                                    (* Current character in music string *)
  258.    C             : CHAR;
  259.                                    (* Note Frequencies *)
  260.   
  261.    Freq          : ARRAY[ 0 .. 6 , 0 .. 11 ] OF INTEGER ABSOLUTE Note_Freqs;
  262.   
  263.    N             : INTEGER;
  264.    XN            : REAL;
  265.    K             : INTEGER;
  266.   
  267. (* ------------------------------------------------------------------------ *)
  268.   
  269. FUNCTION GetInt : INTEGER;
  270.   
  271. (*   --- Get integer from music string --- *) 
  272.   
  273. VAR
  274.    N : INTEGER;
  275.   
  276. BEGIN (* GetInt *)
  277.   
  278.    N := 0;
  279.   
  280.    WHILE( S[I] In ['0'..'9'] ) DO
  281.       BEGIN
  282.          N := N * 10 + ORD( S[I] ) - ORD('0');
  283.          I := I + 1;
  284.       END;
  285.   
  286.    I      := I - 1;
  287.   
  288.    GetInt := N;
  289.   
  290. END   (* GetInt *);
  291.   
  292. (* ------------------------------------------------------------------------ *)
  293.   
  294. BEGIN (* PibPlay *)
  295.                                    (* Append blank to end of music string *)
  296.    S := S + ' ';
  297.                                    (* Point to first character in music *)
  298.    I := 1;
  299.                                    (* BEGIN loop over music string *)
  300.    WHILE( I < LENGTH( S ) ) DO
  301.   
  302.       BEGIN (* Interpret Music *)
  303.                                    (* Get next character in music string *)
  304.          C := UpCase(S[I]);
  305.                                    (* Interpret it                       *)
  306.          CASE C OF
  307.   
  308.             'A'..'G' : BEGIN (* A Note *)
  309.   
  310.                           N         := Note_Offset[ C ];
  311.   
  312.                           Play_Freq := Freq[ Note_Octave , N ];
  313.   
  314.                           XN := Note_Quarter * ( Note_Length / Quarter_Note );
  315.   
  316.                           Play_Duration := TRUNC( XN * Note_Fraction );
  317.   
  318.                           Rest_Duration := TRUNC( XN * ( 1.0 - Note_Fraction ) );
  319.   
  320.                                    (* Check for sharp/flat *)
  321.   
  322.                           IF S[I+1] In ['#','+','-' ] THEN 
  323.                              BEGIN
  324.   
  325.                                 I := I + 1;
  326.   
  327.                                 CASE S[I] OF
  328.                                    '#' : Play_Freq :=
  329.                                             Freq[ Note_Octave , N + 1 ];
  330.                                    '+' : Play_Freq :=
  331.                                             Freq[ Note_Octave , N + 1 ];
  332.                                    '-' : Play_Freq :=
  333.                                             Freq[ Note_Octave , N - 1 ];
  334.                                    ELSE  ;
  335.                                 END (* Case *);
  336.   
  337.                              END;
  338.   
  339.                                    (* Check for note length *) 
  340.   
  341.                           IF S[I+1] In ['0'..'9'] THEN
  342.                              BEGIN
  343.   
  344.                                 I  := I + 1;
  345.                                 N  := GetInt;
  346.                                 XN := ( 1.0 / N ) / Quarter_Note;
  347.   
  348.                                 Play_Duration := 
  349.                                     TRUNC( Note_Fraction * Note_Quarter * XN );
  350.   
  351.                                 Rest_Duration := 
  352.                                    TRUNC( ( 1.0 - Note_Fraction ) *
  353.                                           Xn * Note_Quarter );
  354.   
  355.                              END;
  356.                                    (* Check for dotting *)
  357.   
  358.                              IF S[I+1] = '.' THEN 
  359.                                 BEGIN
  360.   
  361.                                    XN := 1.0;
  362.   
  363.                                    WHILE( S[I+1] = '.' ) DO 
  364.                                       BEGIN
  365.                                          XN := XN * 1.5;
  366.                                          I  := I + 1;
  367.                                       END;
  368.   
  369.                                    Play_Duration :=
  370.                                        TRUNC( Play_Duration * XN );
  371.   
  372.                                 END;
  373.   
  374.                                        (* Play the note *)
  375.   
  376.                           Sound( Play_Freq );
  377.                           Delay( Play_Duration );
  378.                           NoSound; 
  379.                           Delay( Rest_Duration );
  380.   
  381.                        END   (* A Note *);
  382.   
  383.             'M'      : BEGIN (* 'M' Commands *)
  384.   
  385.                           I := I + 1;
  386.                           C := S[I];
  387.   
  388.                           Case C Of 
  389.   
  390.                              'F' : ;
  391.                              'B' : ;
  392.                              'N' : Note_Fraction := 0.875;
  393.                              'L' : Note_Fraction := 1.000;
  394.                              'S' : Note_Fraction := 0.750;
  395.                              ELSE ;
  396.   
  397.                           END (* Case *);
  398.   
  399.   
  400.                        END   (* 'M' Commands *);
  401.   
  402.             'O'      : BEGIN (* Set Octave *)
  403.   
  404.                           I := I + 1;
  405.                           N := ORD( S[I] ) - ORD('0');
  406.   
  407.                           IF ( N < 0 ) OR ( N > 6 ) THEN N := 4;
  408.   
  409.                           Note_Octave := N;
  410.   
  411.                        END   (* Set Octave *);
  412.   
  413.             '<'      : BEGIN (* Drop an octave *)
  414.   
  415.                           IF Note_Octave > 0 THEN
  416.                              Note_Octave := Note_Octave - 1;
  417.   
  418.                        END   (* Drop an octave *);
  419.   
  420.             '>'      : BEGIN (* Ascend an octave *)
  421.   
  422.                           IF Note_Octave < 6 THEN
  423.                              Note_Octave := Note_Octave + 1;
  424.   
  425.                        END   (* Ascend an octave *);
  426.   
  427.             'N'      : BEGIN (* Play Note N *)
  428.   
  429.                           I := I + 1;
  430.   
  431.                           N := GetInt;
  432.   
  433.                           IF ( N > 0 ) AND ( N <= 84 ) THEN 
  434.                              BEGIN
  435.   
  436.                                 Play_Freq    := Note_Freqs[ N ];
  437.   
  438.                                 XN           := Note_Quarter *
  439.                                                 ( Note_Length / Quarter_Note );
  440.   
  441.                                 Play_Duration := TRUNC( XN * Note_Fraction );
  442.   
  443.                                 Rest_Duration := TRUNC( XN * ( 1.0 - Note_Fraction ) );
  444.   
  445.                              END
  446.   
  447.                           ELSE IF ( N = 0 ) THEN
  448.                              BEGIN
  449.   
  450.                                 Play_Freq     := 0;
  451.                                 Play_Duration := 0;
  452.                                 Rest_Duration := 
  453.                                    TRUNC( Note_Fraction * Note_Quarter *
  454.                                           ( Note_Length / Quarter_Note ) );
  455.   
  456.                              END;
  457.   
  458.                           Sound( Play_Freq );
  459.                           Delay( Play_Duration );
  460.                           NoSound; 
  461.                           Delay( Rest_Duration );
  462.   
  463.                        END   (* Play Note N *);
  464.   
  465.             'L'      : BEGIN (* Set Length of Notes *)
  466.   
  467.                           I := I + 1;
  468.                           N := GetInt;
  469.   
  470.                           IF N > 0 THEN Note_Length := 1.0 / N;
  471.   
  472.                        END   (* Set Length of Notes *);
  473.   
  474.             'T'      : BEGIN (* # of quarter notes in a minute *) 
  475.   
  476.                           I := I + 1;
  477.                           N := GetInt;
  478.   
  479.                           Note_Quarter := ( 1092.0 / 18.2 / N ) * 1000.0;
  480.   
  481.                        END   (* # of quarter notes in a minute *); 
  482.   
  483.             'P'      : BEGIN (* Pause *)
  484.   
  485.                           I := I + 1;
  486.                           N := GetInt;
  487.   
  488.                           IF      ( N <  1 ) THEN N := 1
  489.                           ELSE IF ( N > 64 ) THEN N := 64; 
  490.   
  491.                           Play_Freq     := 0;
  492.                           Play_Duration := 0;
  493.                           Rest_Duration :=
  494.                              TRUNC( ( ( 1.0 / N ) / Quarter_Note )
  495.                                     * Note_Quarter );
  496.   
  497.                           Sound( Play_Freq );
  498.                           Delay( Play_Duration );
  499.                           NoSound; 
  500.                           Delay( Rest_Duration );
  501.   
  502.                        END   (* Pause *);
  503.   
  504.             ELSE
  505.                (* Ignore other stuff *);
  506.   
  507.          END (* Case *);
  508.   
  509.          I := I + 1;
  510.   
  511.        END  (* Interpret Music *);
  512.   
  513.                                    (* Make sure sound turned off when through *)
  514.    NoSound;
  515.   
  516. END   (* PibPlay *);
  517.   
  518.